home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / SPADV.ZIP / SHIPED.PAS < prev    next >
Pascal/Delphi Source File  |  1980-01-01  |  5KB  |  177 lines
  1. program SA_SHIP_EDIT;
  2. uses crt;
  3. const
  4.   cchar:array (.0..15.) of char= (#32,#208,#210,#186,#181,#188,#187,#185,
  5.                                   #198,#200,#201,#204,#205,#202,#203,#206);
  6.   sadir='';
  7.   North=1; South=2; West=4; East=8;
  8.   Shield=16; Block=32; Pform=64; Panel=128;
  9.   Ppack=16; Key=17; Crystal=18;
  10. type
  11.   RoomTyp=record
  12.             Interior:word;
  13.             Object:byte;
  14.             Visited:boolean;
  15.           end;
  16. var
  17.   l,x,y,ctr:byte;
  18.   k,k2:char;
  19.   ship:array [1..3,1..14,1..3] of roomtyp;
  20.  
  21. function outside (x,y:byte):boolean;
  22. begin
  23.   outside:=(((x=1) or ((x>3) and (x<9))) and (y<>2))
  24.            and not ((l=2) and (x=6) and (y=1));
  25. end;
  26.  
  27. procedure putchr (l,x,y:byte; ch:char);
  28. begin
  29.   gotoxy(x+4,l*4+y-2); if ch<>#0 then write (ch);
  30. end;
  31.  
  32. procedure drawship;
  33. begin
  34.   clrscr;
  35.   for l:=1 to 3 do begin
  36.     gotoxy(1,4*l); write (l:1);
  37.     gotoxy(4,4*l); write ('<');
  38.     if l=2 then begin
  39.       putchr(2,5,1,'<');
  40.       putchr(2,7,1,'<');
  41.     end;
  42.     for y:=1 to 3 do begin
  43.       gotoxy(3,4*l+y-2); write (y:1);
  44.       putchr (l,15,y,'<');
  45.       for x:=1 to 14 do begin
  46.         gotoxy(x+4,l*4-2); write (x:1);
  47.         if ((y=1) and ((x=1) or (x=8))) or ((y=3) and (x=4)) then putchr (l,x,y,'/');
  48.         if ((y=3) and ((x=1) or (x=8))) or ((y=1) and (x=4)) then putchr (l,x,y,'\');
  49.         if not outside (x,y) then putchr (l,x,y,cchar[ship[l,x,y].interior and 15]);
  50.         if (y=2) and ((x=1) or (x=12)) then putchr (l,x,y,'T');
  51.       end;
  52.     end;
  53.   end;
  54. end;
  55.  
  56. procedure clr;
  57. begin
  58.   window (1,15,40,24); clrscr; window (1,1,40,25);
  59. end;
  60.  
  61. procedure LoadShip;
  62. var
  63.   FilVar:file of RoomTyp;
  64.   l,x,y:byte;
  65. begin
  66.   Gotoxy(1,23); write ('Ok to Load ''SHIP.DAT''? ');
  67.   k:=readkey; if k in ['Y','y'] then begin
  68.     Assign(FilVar,SAdir+'SHIP.DAT');
  69.     Reset(FilVar);
  70.     for L:=1 to 3 do
  71.       for X:=1 to 14 do
  72.         for Y:=1 to 3 do
  73.           Read (FilVar,Ship[L,X,Y]);
  74.     Close (FilVar);
  75.     drawship;
  76.   end;
  77.   clr;
  78. end;
  79.  
  80. procedure SaveShip;
  81. var
  82.   FilVar:file of RoomTyp;
  83.   l,x,y:byte;
  84. begin
  85.   Gotoxy(1,23); write ('Ok to Save ''SHIP.DAT''? ');
  86.   k:=readkey; if k in ['Y','y'] then begin
  87.     Assign(FilVar,SAdir+'SHIP.DAT');
  88.     Rewrite(FilVar);
  89.     for l:=1 to 3 do
  90.       for X:=1 to 14 do
  91.         for Y:=1 to 3 do
  92.           Write (FilVar,Ship[L,X,Y]);
  93.     Close (FilVar);
  94.   end;
  95.   clr;
  96. end;
  97.  
  98.  
  99. begin
  100.   textmode(c40);
  101.   drawship;
  102.   l:=2; x:=6; y:=1;
  103.   repeat
  104.     gotoxy(1,16);
  105.     with ship[l,x,y] do begin
  106.       Write ('   Exits : ');
  107.       if (interior and north)>0 then write ('Up ');
  108.       if (interior and south)>0 then write ('Down ');
  109.       if (interior and west)>0 then write ('Left ');
  110.       if (interior and east)>0 then write ('Right ');
  111.       writeln; write ('Interior : ');
  112.       if (interior and shield)>0 then write ('Shields  ');
  113.       if (interior and block)>0 then write ('Blocks  ');
  114.       if (interior and pform)>0 then write ('Platforms  ');
  115.       if (interior and Panel)>0 then write ('Computer ');
  116.       writeln; write ('  Object : ');
  117.       case Object of
  118.         Ppack  : write ('Power Pack');
  119.         Key    : write ('Electronic Key');
  120.         Crystal: write ('Crystal');
  121.       end;
  122.       writeln; write ('Androids : ');
  123.       case Visited of
  124.         false:write ('Yes');
  125.         true:write ('No');
  126.       end;
  127.       writeln; write (' Special : ');
  128.       if (y=2) and ((x=1) or (x=12)) then write ('Teleport ');
  129.       if (l=2) and (y=1) and (x=6) then write ('Your craft ');
  130.       if Outside (x,y) then write ('Outside ship ');
  131.       writeln;
  132.     end;
  133.     if not outside (x,y) and not((y=2) and ((x=1) or (x=12)))
  134.       then putchr(l,x,y,cchar(.ship(.l,x,y.).interior and 15.));
  135.     putchr (l,x,y,#0);
  136.     k:=upcase(readkey);
  137.     with ship[l,x,y] do begin
  138.       if (k=#0) and keypressed then begin
  139.         k2:=readkey;
  140.         case k2 of
  141.           'H':y:=y-1;
  142.           'P':y:=y+1;
  143.           'K':x:=x-1;
  144.           'M':x:=x+1;
  145.           #59:loadship;
  146.           #60:saveship;
  147.           #61:begin
  148.                 Interior:=0; Object:=0; Visited:=True;
  149.               end;
  150.         end;
  151.       end;
  152.       if (k<>#0) and not outside (x,y) then case k of
  153.         'U':Interior:=Interior xor North;
  154.         'D':Interior:=Interior xor South;
  155.         'L':Interior:=Interior xor West;
  156.         'R':Interior:=Interior xor East;
  157.  
  158.         'S':Interior:=Interior xor Shield;
  159.         'B':Interior:=Interior xor Block;
  160.         'P':Interior:=Interior xor Pform;
  161.         'C':Interior:=Interior xor Panel;
  162.  
  163.         'O':begin
  164.               Inc(Object);
  165.               if Object=19 then Object:=0;
  166.               if Object=1 then Object:=16;
  167.             end;
  168.         'A':Visited:=not Visited;
  169.       end;
  170.       if x<1 then x:=14 else if x>14 then x:=1;
  171.       if y<1 then begin y:=3; l:=l-1; end else if y>3 then begin y:=1; l:=l+1; end;
  172.       if l<1 then l:=3 else if l>3 then l:=1;
  173.     end;
  174.     clr;
  175.   until k=#27;
  176. end.
  177.